home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE03 / EXPERTS / DLLSKEXP.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-06  |  8KB  |  275 lines
  1. unit Dllskexp;
  2. interface
  3. uses
  4.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  5.   Forms, Dialogs, Buttons, StdCtrls, ExptIntf, ToolIntf;
  6.  
  7. type
  8.   TDLLSKeletonGenerator = class(TForm)
  9.     Main: TGroupBox;
  10.     DLLLabel: TLabel;
  11.     DLLName: TEdit;
  12.     ExitCode: TGroupBox;
  13.     FunctionCheckBox: TCheckBox;
  14.     ProcedureCheckBox: TCheckBox;
  15.     Ok: TBitBtn;
  16.     Cancel: TBitBtn;
  17.     Help: TBitBtn;
  18.     ExampleCode: TGroupBox;
  19.     ExitProcCheckBox: TCheckBox;
  20.     BPWCompatibleCheckBox: TCheckBox;
  21.     ResourceCheckBox: TCheckBox;
  22.  
  23.     procedure DLLNameChange(Sender: TObject);
  24.     procedure CancelClick(Sender: TObject);
  25.     procedure HelpClick(Sender: TObject);
  26.     procedure ExitProcCheckBoxClick(Sender: TObject);
  27.     procedure OkClick(Sender: TObject);
  28.   private
  29.     { Private declarations }
  30.   public
  31.     { Public declarations }
  32.   end;
  33.  
  34. var
  35.   DLLSKeletonGenerator: TDLLSKeletonGenerator;
  36.  
  37. Type
  38.   TDLLSkeletonStandardExpert = class(TIExpert)
  39.   public
  40.     { Expert Style }
  41.     function GetStyle: TExpertStyle; override;
  42.     { Expert Strings }
  43.     function GetIDString: string; override;
  44.     function GetName: string; override;
  45.     function GetComment: string; override;
  46.     function GetGlyph: HBITMAP; override;
  47.     function GetState: TExpertState; override;
  48.     function GetMenuText: string; override;
  49.     { Launch the Expert }
  50.     procedure Execute; override;
  51.   end;
  52.  
  53.   TDLLSkeletonProjectExpert = class(TDLLSkeletonStandardExpert)
  54.   public
  55.     { Expert Style }
  56.     function GetStyle: TExpertStyle; override;
  57.     { Expert Strings }
  58.     function GetIDString: string; override;
  59.     function GetComment: string; override;
  60.     function GetGlyph: HBITMAP; override;
  61.   end;
  62.  
  63.   procedure Register;
  64.  
  65. implementation
  66.  
  67. {$R *.DFM}
  68.  
  69. procedure TDLLSKeletonGenerator.DLLNameChange(Sender: TObject);
  70. begin
  71.   ExitProcCheckBox.Caption := 'procedure '+DLLName.Text+'ExitProc;';
  72.   ResourceCheckBox.Caption := 'Include {$R '+DLLName.Text+'.RES};';
  73. end;
  74.  
  75. procedure TDLLSKeletonGenerator.ExitProcCheckBoxClick(Sender: TObject);
  76. { if ExitProcChecked is False, then BPWCompatibleCheckBox is irrelevant,
  77.   otherwise it should be set to True by default.
  78. }
  79. begin
  80.   BPWCompatibleCheckBox.Checked := ExitProcCheckBox.Checked;
  81.   BPWCompatibleCheckBox.Enabled := ExitProcCheckBox.Checked
  82. end;
  83.  
  84. procedure TDLLSKeletonGenerator.CancelClick(Sender: TObject);
  85. begin
  86.   Close;
  87. end;
  88.  
  89. procedure TDLLSKeletonGenerator.HelpClick(Sender: TObject);
  90. begin
  91.   MessageDlg('Read the article in *The Delphi Magazine* for in-depth information'#13+
  92.              'on how to write your own Delphi Experts! (send an e-mail message'#13+
  93.              'to the editor Chris Frizelle at 70630.717@compuserve.com for free'#13+
  94.              'sample issue). Full source will be on subscribers'' disk...',
  95.               mtInformation, [mbOk], 0);
  96. end;
  97.  
  98. procedure TDLLSKeletonGenerator.OkClick(Sender: TObject);
  99. var f: System.Text;
  100. begin
  101.   if (DLLName.Text <> '') and
  102.     ((not FileExists(ExtractFileName(DLLName.Text)+'.PAS')) or
  103.      (MessageDlg('File '+ExtractFileName(DLLName.Text)+'.PAS exists. Overwrite?',
  104.                   mtConfirmation, [mbYes,mbNo], 0) = IdYes)) then
  105.   begin
  106.     System.Assign(f,ExtractFileName(DLLName.Text)+'.PAS');
  107.     Rewrite(f);
  108.     writeln(f,'library ',ExtractFileName(DLLName.Text),';');
  109.     writeln(f,'{ Generated by DLL Skeleton Expert (c) 1995 by Dr.Bob for The Delphi Magazine }');
  110.     if ExitProcCheckBox.Checked and not BPWCompatibleCheckBox.Checked then
  111.       writeln(f,'uses WinTypes, WinProcs, SysUtils;')
  112.     else writeln(f,'uses WinTypes, WinProcs;');
  113.     writeln(f);
  114.     { Resources }
  115.     if ResourceCheckBox.Checked then
  116.     begin
  117.       writeln(f,'{$R ',ExtractFileName(DLLName.Text),'.RES}');
  118.       writeln(f)
  119.     end;
  120.     { Functions & Procedures }
  121.     if FunctionCheckBox.Checked then
  122.     begin
  123.       writeln(f,'  function Max(X,Y: Integer): Integer; export;');
  124.       writeln(f,'  begin');
  125.       writeln(f,'    if X > Y then Max := X');
  126.       writeln(f,'             else Max := Y');
  127.       writeln(f,'  end {Max};');
  128.       writeln(f)
  129.     end;
  130.     if ProcedureCheckBox.Checked then
  131.     begin
  132.       writeln(f,'  procedure Swap(var X,Y: Integer); export;');
  133.       writeln(f,'  var Z: Integer;');
  134.       writeln(f,'  begin');
  135.       writeln(f,'    Z := X;');
  136.       writeln(f,'    X := Y;');
  137.       writeln(f,'    Y := Z');
  138.       writeln(f,'  end {Swap};');
  139.       writeln(f)
  140.     end;
  141.     { Exports }
  142.     if FunctionCheckBox.Checked or ProcedureCheckBox.Checked then
  143.     begin
  144.       write(f,'exports ');
  145.       if FunctionCheckBox.Checked then write(f,'max index 1');
  146.       if ProcedureCheckBox.Checked then
  147.       begin
  148.         if FunctionCheckBox.Checked then
  149.         begin
  150.           writeln(f,',');
  151.           write(f,' ':7);
  152.         end;
  153.         write(f,'swap index 2');
  154.       end;
  155.       writeln(f,';');
  156.       writeln(f)
  157.     end;
  158.     { Exitproc }
  159.     if ExitProcCheckBox.Checked then
  160.     begin
  161.       if BPWCompatibleCheckBox.Checked then
  162.       begin
  163.         writeln(f,'var SaveExit: pointer;');
  164.         writeln(f)
  165.       end;
  166.       writeln(f,'  procedure ',ExtractFileName(DLLName.Text),'ExitProc; far;');
  167.       writeln(f,'  begin');
  168.       if BPWCompatibleCheckBox.Checked then
  169.         writeln(f,'    ExitProc := SaveExit;');
  170.       writeln(f,'    { WEP & cleanup }');
  171.       writeln(f,'  end;');
  172.       writeln(f);
  173.     end;
  174.     { Begin }
  175.     writeln(f,'begin');
  176.     if ExitProcCheckBox.Checked then
  177.     begin
  178.       if BPWCompatibleCheckBox.Checked then
  179.       begin
  180.         writeln(f,'  SaveExit := ExitProc;');
  181.         writeln(f,'  ExitProc := @',ExtractFileName(DLLName.Text),'ExitProc;')
  182.       end
  183.       else
  184.         writeln(f,'  AddExitProc(',ExtractFileName(DLLName.Text),'ExitProc);')
  185.     end;
  186.     writeln(f,'end.');
  187.     System.Close(f);
  188.  
  189.     if ToolServices <> nil then { I'm an expert!! }
  190.     begin
  191.       if ToolServices.CloseProject then
  192.         ToolServices.OpenProject(ExtractFileName(DLLName.Text)+'.PAS');
  193.       Close
  194.     end
  195.   end
  196. end;
  197.  
  198.  
  199. function TDLLSkeletonStandardExpert.GetStyle: TExpertStyle;
  200. begin
  201.   Result := esStandard
  202. end;
  203.  
  204. function TDLLSkeletonStandardExpert.GetIDString: String;
  205. begin
  206.   Result := 'DrBob.StandardDLLSkExp'
  207. end;
  208.  
  209. function TDLLSkeletonStandardExpert.GetComment: String;
  210. begin
  211.   Result := '' { not needed for esStandard }
  212. end;
  213.  
  214. function TDLLSkeletonStandardExpert.GetGlyph: HBITMAP;
  215. begin
  216.   Result := 0 { not needed for esStandard }
  217. end;
  218.  
  219. function TDLLSkeletonStandardExpert.GetName: String;
  220. begin
  221.   Result := 'DLL Skeleton Generator'
  222. end;
  223.  
  224. function TDLLSkeletonStandardExpert.GetState: TExpertState;
  225. begin
  226.   Result := [esEnabled]
  227. end;
  228.  
  229. function TDLLSkeletonStandardExpert.GetMenuText: String;
  230. begin
  231.   Result := 'Dr.&Bob''s DLL Skeleton Expert...'
  232. end;
  233.  
  234. procedure TDLLSkeletonStandardExpert.Execute;
  235. begin
  236.   if not Assigned(DLLSkeletonGenerator) then
  237.     DLLSkeletonGenerator := TDLLSkeletonGenerator.Create(Application);
  238.   DLLSkeletonGenerator.Show;
  239.   DLLSkeletonGenerator.SetFocus
  240. end;
  241.  
  242. {$R DLLSKEXP.RES}
  243. Const
  244.   DLLSKEXPBITMAP = 666; { Bitmap ID }
  245.  
  246. function TDLLSkeletonProjectExpert.GetStyle: TExpertStyle;
  247. begin
  248.   Result := esProject
  249. end;
  250.  
  251. function TDLLSkeletonProjectExpert.GetIDString: String;
  252. begin
  253.   Result := 'DrBob.ProjectDLLSkExp'
  254. end;
  255.  
  256. function TDLLSkeletonProjectExpert.GetComment: String;
  257. begin
  258.   Result := 'This Project Experts generates and opens a DLL Skeleton Source File'#13+
  259.             'DLL Skeleton Expert (c) 1995 by Dr.Bob for The Delphi Magazine';
  260. end;
  261.  
  262. function TDLLSkeletonProjectExpert.GetGlyph: HBITMAP;
  263. begin
  264.   Result := LoadBitMap(HInstance, MakeIntResource(DLLSKEXPBITMAP))
  265. end;
  266.  
  267.  
  268. procedure Register;
  269. begin
  270.   RegisterLibraryExpert(TDLLSkeletonStandardExpert.Create);
  271.   RegisterLibraryExpert(TDLLSkeletonProjectExpert.Create)
  272. end;
  273.  
  274. end.
  275.